Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Developer Essentials/DTS Sample Code/Macintosh Sample Code/SC.020.Transformer/UTransformer.inc1.p

Text File | 1989-09-30 | 13.6 KB | 519 lines | [TEXT/MPS ]

{[j=20/57/1$]}
{[f-]}
{------------------------------------------------------------------------------
#
#    Apple Macintosh Developer Technical Support
#
#    BitMap Transformer
#
#    UTransformer.inc1.p -    Pascal Source
#
#    Copyright © 1989 Apple Computer, Inc.
#    All rights reserved.
#
#    Versions:
#                1.0                         10/89
#
#    Components:
#                MTransformer.p                October 1, 1989
#                UTransformer.p                October 1, 1989
#                UTransformer.inc1.p         October 1, 1989
#                Transformer.c                October 1, 1989
#                Transformer.r                October 1, 1989
#                Transformer.MAMake            October 1, 1989
#                ProjInit                    October 1, 1989
#                The BitMap Transmogrifier    October 1, 1989
#
#    Requirements:
#                MacApp® 2.0ß9                July 10, 1989
#
# "Transformers" is a sample program that demonstrates how to translate,
# rotate, and scale bitmaps. It uses a MacApp shell to open file, open
# windows, and handle menus, but the core routine is written in vanilla C.
#
------------------------------------------------------------------------------}
{[f+]}

{--------------------------------------------------------------------------------------------------}
{ G L O B A L    V A R I A B L E S }
{--------------------------------------------------------------------------------------------------}

VAR
    gRotation           : INTEGER;
    gCenter            : Point;
    gDestination       : Point;
    gScaleX            : Extended;
    gScaleY            : Extended;

{--------------------------------------------------------------------------------------------------}
    { E X T E R N A L    R O U T I N E S }
{--------------------------------------------------------------------------------------------------}

    { From Transformer.c }

PROCEDURE GetThePicture(aRefNum: INTEGER; data: Ptr);
    EXTERNAL;

PROCEDURE DoTransform(sourceBM, destBM: BitMap; center, destination: Point; rotation: INTEGER; Sx,
                      Sy: Extended96);
    EXTERNAL;

{--------------------------------------------------------------------------------------------------}
{ G L O B A L S }
{--------------------------------------------------------------------------------------------------}

PROCEDURE ClearBitMap(aBitMap: BitMap);

    VAR
        oldPort            : GrafPtr;
        oldBits            : BitMap;
        tempPort           : GrafPort;

    BEGIN
        GetPort(oldPort);
        OpenPort(@tempPort);
        oldBits := tempPort.portBits;
        SetPortBits(aBitMap);
        WITH tempPort DO BEGIN
            portRect := portBits.bounds;
            ClipRect(portRect);
            CopyRgn(clipRgn, visRgn);
            EraseRect(portRect);
        END;
        SetPortBits(oldBits);
        ClosePort(@tempPort);
        SetPort(oldPort);
    END;

{--------------------------------------------------------------------------------------------------}
{ T T r a n s f o r m e r A p p l i c a t i o n }
{--------------------------------------------------------------------------------------------------}

PROCEDURE TTransformerApplication.ITransformerApplication(itsMainFileType: OSType);

    BEGIN
        IApplication(itsMainFileType);

        RegisterStdType('TBitMapView', 'dflt');         { So my view will be substituted when
                                                         MacApp® creates the "default view" }

        gRotation := 0;
        gScaleX := 1;
        gScaleY := 1;
        gCenter := gZeroPt;
        gDestination := gZeroPt;

        InitCursorCtl(NIL);                             { Use the cursor data in the resource fork }

        IF gDeadStripSuppression THEN BEGIN
            IF Member(TObject(NIL), TBitMapView) THEN;
            IF Member(TObject(NIL), TExtNumberText) THEN;
        END;
    END;

{--------------------------------------------------------------------------------------------------}

FUNCTION TTransformerApplication.AlreadyOpen(fileName: Str255;
    volRefnum: INTEGER): TDocument; OVERRIDE;

    BEGIN
        AlreadyOpen := NIL;
    END;

{--------------------------------------------------------------------------------------------------}

FUNCTION TTransformerApplication.DoMakeDocument(itsCmdNumber: CmdNumber): TDocument;

    VAR
        aDocument           : TBitMapDocument;

    BEGIN
        { Allocate and initialize the document}
        NEW(aDocument);
        FailNIL(aDocument);

        aDocument.IBitMapDocument;
        DoMakeDocument := aDocument;
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TTransformerApplication.HandleFinderRequest; OVERRIDE;

    BEGIN
        IF gFileCount > 0 THEN
            INHERITED HandleFinderRequest;
    END;

{--------------------------------------------------------------------------------------------------}
{ T B i t M a p D o c u m e n t }
{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapDocument.IBitMapDocument;

    VAR
        fi                   : FailInfo;
        data               : Ptr;
        aBitMap            : BitMap;
        oldPerm            : Boolean;
        bmSize               : LONGINT;

    PROCEDURE HandleFailure(error: OSErr; message: LONGINT);

        BEGIN
            Free;
        END;

    BEGIN
        fOrigBitMap.baseAddr := NIL;
        IDocument(gMainFileType, kSignature, kUsesDataFork, NOT kUsesRsrcFork, NOT kDataOpen,
                  NOT kRsrcOpen);

        WITH fOrigBitMap DO BEGIN
            rowBytes := kRowBytes;
            WITH bounds DO BEGIN
                top := 0;
                left := 0;
                bottom := kHeight;
                right := kWidth;
                bmSize := LONGINT(rowBytes) * bottom;
            END;
        END;

        CatchFailures(fi, HandleFailure);

        oldPerm := PermAllocation(TRUE);
        data := NewPtrClear(bmSize);
        oldPerm := PermAllocation(oldPerm);
        FailNIL(data);
        fOrigBitMap.baseAddr := data;

        Success(fi);
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapDocument.Free; OVERRIDE;

    BEGIN
        DisposIfPtr(fOrigBitMap.baseAddr);
        INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapDocument.CopyOrigBits(aBitMap: BitMap);

    VAR
        sourceBitMap       : BitMap;

    BEGIN
        sourceBitMap := fOrigBitMap;
        CopyBits(sourceBitMap, aBitMap, sourceBitMap.bounds, sourceBitMap.bounds, srcCopy, NIL);
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapDocument.DoRead(aRefNum: INTEGER; rsrcExists, forPrinting: Boolean); OVERRIDE;

    BEGIN
        GetThePicture(aRefNum, fOrigBitMap.baseAddr);
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapDocument.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                     fieldType: INTEGER)); OVERRIDE;

    BEGIN
        DoToField('TBitMapDocument', NIL, bClass);
        DoToField('fOrigBitMap', NIL, bTitle);
        DoToField('  baseAddr', @fOrigBitMap.baseAddr, bPointer);
        DoToField('  rowBytes', @fOrigBitMap.rowBytes, bInteger);
        DoToField('  bounds', @fOrigBitMap.bounds, bRect);

        INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapDocument.GetOrigBitMap(VAR aBitMap: BitMap);

    BEGIN
        aBitMap := fOrigBitMap;
    END;

{--------------------------------------------------------------------------------------------------}
{ T B i t M a p V i e w }
{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapView.IRes(itsDocument: TDocument; itsSuperview: TView;
    VAR itsParams: Ptr); OVERRIDE;

    VAR
        fi                   : FailInfo;
        data               : Ptr;
        aBitMap            : BitMap;
        oldPerm            : Boolean;
        bmSize               : LONGINT;

    PROCEDURE HandleFailure(error: OSErr; message: LONGINT);

        BEGIN
            Free;
        END;

    BEGIN
        fTransBitMap.baseAddr := NIL;
        INHERITED IRes(itsDocument, itsSuperview, itsParams);

        WITH fTransBitMap DO BEGIN
            rowBytes := kRowBytes;
            WITH bounds DO BEGIN
                top := 0;
                left := 0;
                bottom := kHeight;
                right := kWidth;
                bmSize := LONGINT(rowBytes) * bottom;
            END;
        END;

        CatchFailures(fi, HandleFailure);

        oldPerm := PermAllocation(TRUE);
        data := NewPtrClear(bmSize);
        oldPerm := PermAllocation(oldPerm);
        FailNIL(data);
        fTransBitMap.baseAddr := data;

        Success(fi);

        aBitMap := fTransBitMap;
        TBitMapDocument(fDocument).CopyOrigBits(aBitMap);
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapView.Free; OVERRIDE;

    BEGIN
        DisposIfPtr(fTransBitMap.baseAddr);
        INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapView.CallTransform(rotation: INTEGER; Sx, Sy: Extended);

    VAR
        sourceBitMap       : BitMap;
        destBitMap           : BitMap;
        center               : Point;
        destination        : Point;

    BEGIN
        TBitMapDocument(fDocument).GetOrigBitMap(sourceBitMap);
        destBitMap := fTransBitMap;

        WITH sourceBitMap.bounds DO BEGIN
            center.h := right DIV 2;
            center.v := bottom DIV 2;
        END;

        WITH destBitMap.bounds DO BEGIN
            destination.h := right DIV 2;
            destination.v := bottom DIV 2;
        END;

        DoTransform(sourceBitMap, destBitMap, center, destination, rotation, X80toX96(Sx),
                    X80toX96(Sy));
        ForceRedraw;
    END;

{--------------------------------------------------------------------------------------------------}

FUNCTION TBitMapView.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; OVERRIDE;

    VAR
        aBitMap            : BitMap;
        aWindow            : TWindow;
        dismisser           : IDType;
        sourceBitMap       : BitMap;
        destBitMap           : BitMap;

    BEGIN
        DoMenuCommand := gNoChanges;
        CASE aCmdNumber OF
            cNormal: BEGIN
                aBitMap := fTransBitMap;
                TBitMapDocument(fDocument).CopyOrigBits(aBitMap);
                ForceRedraw;
            END;
            cRot90: BEGIN
                CallTransform(90, 1.0, 1.0);
            END;
            cRot45: BEGIN
                CallTransform(45, 1.0, 1.0);
            END;
            cScale2: BEGIN
                CallTransform(0, 2.0, 2.0);
            END;
            cScaleHalf: BEGIN
                CallTransform(0, 0.5, 0.5);
            END;
            cRot45ScaleHalf: BEGIN
                CallTransform(45, 0.5, 0.5);
            END;
            cCustom: BEGIN
                aWindow := NewTemplateWindow(kOptionsDialog, NIL);
                dismisser := TDialogView(aWindow.FindSubView('DLOG')).PoseModally;
                IF (dismisser = 'OKOK') THEN BEGIN
                    WITH aWindow DO BEGIN
                        gRotation := TNumberText(FindSubView('ndeg')).GetValue;
                        WITH gCenter DO BEGIN
                            h := TNumberText(FindSubView('ncrx')).GetValue;
                            v := TNumberText(FindSubView('ncry')).GetValue;
                        END;
                        WITH gDestination DO BEGIN
                            h := TNumberText(FindSubView('ntrx')).GetValue;
                            v := TNumberText(FindSubView('ntry')).GetValue;
                        END;
                        gScaleX := TExtNumberText(FindSubView('nscx')).GetExtValue;
                        gScaleY := TExtNumberText(FindSubView('nscy')).GetExtValue;
                        Close;
                    END;

                    IF Focus THEN;
                    BeginUpdate(thePort);                {Use thePort because we know we're focused}
                    EraseRect(thePort^.portRect);
                    DrawContents;
                    EndUpdate(thePort);

                    TBitMapDocument(fDocument).GetOrigBitMap(sourceBitMap);
                    destBitMap := fTransBitMap;

                    {$IFC qDebug}
                    WrLblPt('gCenter', gCenter); Writeln;
                    WrLblPt('gDestination', gDestination); Writeln;
                    Writeln('gRotation = ', gRotation: 1);
                    Writeln('gScaleX = ', gScaleX: 1);
                    Writeln('gScaleY = ', gScaleY: 1);
                    {$ENDC}

                    DoTransform(sourceBitMap, destBitMap, gCenter, gDestination, gRotation,
                                X80toX96(gScaleX), X80toX96(gScaleY));
                    ForceRedraw;
                END
                ELSE BEGIN
                    aWindow.Close;
                END;
            END;
            OTHERWISE DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
        END;
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapView.DoSetupMenus; OVERRIDE;

    BEGIN
        INHERITED DoSetupMenus;

        Enable(cNormal, TRUE);
        Enable(cRot90, TRUE);
        Enable(cRot45, TRUE);
        Enable(cScale2, TRUE);
        Enable(cScaleHalf, TRUE);
        Enable(cRot45ScaleHalf, TRUE);
        Enable(cCustom, TRUE);
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapView.Draw(area: Rect); OVERRIDE;

    VAR
        aBitMap            : BitMap;

    BEGIN
        aBitMap := fTransBitMap;
        CopyBits(aBitMap, GetWindow.GetGrafPort^.portBits, area, area, srcCopy, NIL);
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TBitMapView.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                 fieldType: INTEGER)); OVERRIDE;

    BEGIN
        DoToField('fTransBitMap', NIL, bTitle);
        DoToField('  baseAddr', @fTransBitMap.baseAddr, bPointer);
        DoToField('  rowBytes', @fTransBitMap.rowBytes, bInteger);
        DoToField('  bounds', @fTransBitMap.bounds, bRect);

        INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{ T E x t N u m b e r T e x t }
{--------------------------------------------------------------------------------------------------}

FUNCTION TExtNumberText.GetExtValue: Extended;

    VAR
        aString            : Str255;

    BEGIN
        GetText(aString);
        GetExtValue := Str2Num(aString);
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TExtNumberText.SetExtValue(ext: Extended; redraw: Boolean);

    VAR
        aString            : DecStr;
        form               : DecForm;

    BEGIN
        WITH form DO BEGIN
            style := FloatDecimal;
            digits := 0;
        END;
        Num2Str(form, ext, aString);
        SetText(aString, redraw);
    END;

{--------------------------------------------------------------------------------------------------}

FUNCTION TExtNumberText.Validate: LONGINT; OVERRIDE;

    VAR
        theString           : Str255;
        decRec               : Decimal;
        extValue           : Extended;
        index               : INTEGER;
        validPrefix        : Boolean;

    BEGIN
        Validate := kValidValue;

        GetText(theString);
        IF theString = '' THEN
            theString := '0';

        index := 1;
        Str2Dec(theString, index, decRec, validPrefix);
        IF validPrefix & (index > Length(theString)) THEN BEGIN
            extValue := Dec2Num(decRec);
            IF extValue < fMinimum THEN
                Validate := kValueTooSmall
            ELSE IF extValue > fMaximum THEN
                Validate := kValueTooLarge;
        END
        ELSE BEGIN
            Validate := kNonNumericCharacters;
        END;
    END;